home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / conver1a / clscolor.cls
Text File  |  1999-09-08  |  2KB  |  81 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsColor"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Public Sub Get_RGB(vl As Long, cl() As Byte)
  17. Dim HexColor As String
  18. HexColor = StrReverse(BinToHEX(DecToBin(vl)))
  19. cl(0) = HexToDec(Mid(HexColor, 1, 2))
  20. cl(1) = HexToDec(Mid(HexColor, 3, 2))
  21. cl(2) = HexToDec(Mid(HexColor, 5, 2))
  22. End Sub
  23. Private Function DecToBin(intNumber As Long) As String
  24. Dim strBin As String
  25. Dim intTemp As Long
  26. Dim dblBin As Double
  27. strBin = 0
  28. While intNumber > 0
  29.     strBin = strBin & intNumber Mod 2
  30.     intNumber = (intNumber / 2) - 0.1
  31. Wend
  32. DecToBin = Format(StrReverse(strBin), "000000000000000000000000")
  33. End Function
  34.  
  35.  
  36. Private Function BinToHEX(binNum As String) As String
  37. Dim hexNumbers(1 To 6) As String * 1
  38. Dim i%, tmp As Byte, tmp2
  39.  
  40. For i = 1 To 24 Step 4
  41.     tmp2 = Mid(binNum, i, 4) '
  42.     tmp = Mid(tmp2, 1, 1) * 8 + Mid(tmp2, 2, 1) * 4 + Mid(tmp2, 3, 1) * 2 + Mid(tmp2, 4, 1) * 1 'GetDec()
  43.     BinToHEX = BinToHEX & Hex(tmp)
  44. Next
  45. End Function
  46.  
  47. Private Function HexToDec(Expression As String) As Byte
  48. Dim i As Byte
  49. Dim vl As String
  50. For i = 1 To 2
  51.     Select Case Mid(Expression, i, 1)
  52.         Case "0": vl = vl & "0000"
  53.         Case "1": vl = vl & "0001"
  54.         Case "2": vl = vl & "0010"
  55.         Case "3": vl = vl & "0011"
  56.         Case "4": vl = vl & "0100"
  57.         Case "5": vl = vl & "0101"
  58.         Case "6": vl = vl & "0110"
  59.         Case "7": vl = vl & "0111"
  60.         Case "8": vl = vl & "1000"
  61.         Case "9": vl = vl & "1001"
  62.         Case "A": vl = vl & "1010"
  63.         Case "B": vl = vl & "1011"
  64.         Case "C": vl = vl & "1100"
  65.         Case "D": vl = vl & "1101"
  66.         Case "E": vl = vl & "1110"
  67.         Case "F": vl = vl & "1111"
  68.     End Select
  69. Next
  70. HexToDec = 0
  71. For i = 1 To 8
  72.      If Mid(vl, i, 1) = 1 Then HexToDec = HexToDec + 2 ^ (i - 1)
  73. Next
  74. End Function
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.